          SUBROUTINE (OID,GEN,LDID,LOG.MV,NEW.ORDER,PASS.XTRA)
** Version# 46.0001 - 03/15/2010 - 06:42pm - SMITJR - eclipse
*** V46.0001 Change - Custom Coding SMITJR - 03/15/2010 - SMITJR - eclipse

*** SUBROUTINE - OE.PROCURE
*-------------------------------------------------------------------------*
*** This routine is used to Procure items from Order Entry.
*** It is called from the Schedule and Order Entry Procure Items screens.
*-------------------------------------------------------------------------*
*** OID       - Order ID                                   (IN)
*** GEN       - Current GEN of Order                       (IN)
*** LDID      - Line ID of product on the Order            (IN)
*** LOG.MV    - Multi-valued list of Log GENs              (IN)
*** NEW.ORDER - Indicates if this is a New Order           (IN)
*** PASS.XTRA - Extra data as needed                       (IN/OUT)
***             Field 1 Unavailable All Flag for WIP (OUT)
*-------------------------------------------------------------------------*
*** LD array must be active as must the LED array
*** PRD must be active
*-------------------------------------------------------------------------*
          PN = LD(1)
          MODE = OID[1,1]

          DIM PRC.GRP(10)
          CHECK.KEY 'PROCUREMENT',ENTRY.OK,KEY.LVL
          IF NOT(ENTRY.OK) THEN PRINT BELL:; RETURN
          CHECK.KEY 'PROCUREMENT.OVERRIDE.AVL',OV.AVL.OK
          CHECK.KEY 'PROCUREMENT.ALL.BRS',ALL.BRS.OK

          READV NEW.PIL FROM CTRLFILE,'SOE.NEW.PIL.CHECK',1 ELSE NEW.PIL=''
          READV DIR.PIL FROM CTRLFILE,'SOE.DIR.PIL.CHECK',1 ELSE DIR.PIL=''

          CTRB.ID = 'PROC.VENDOR.CONSIGN~':LED(2)<1,GEN,2>
          READ CONSIGN.WARN FROM CTRBFILE,CTRB.ID ELSE
             CONSIGN.WARN = NO
          END
          GET.BR.LEADTIME BR.LEADTIME
          QSIGN       = -1
          IF (OID[1,1]#'S' AND OID[1,1]#'W') OR LD(4)>0 THEN PRINT BELL:; RETURN

          WINDOW ,,,,9,'OE.PROCURE'
          VSCROLL.DEFINE 1,1,3,77,7,'OE.PROCURE'
          VSCROLL.SET 1

          GOSUB INIT
          GOSUB DISPLAY

          IF MAX.QTY-AVAIL.NOW < 1 THEN
             MESS 40,5,'No Procurable Qty'
          END

          IF LN.CT < 1 THEN
             MESS 5,5,"No Procurement Sources Available"
          END

          QUIT = 0; MOVE = 0; LASTKEY = 0
          LINE = 1; COLS = 2; COL = 1
*-------------------------------------------------------------------------*
MOVENEXT: IF QUIT THEN GOTO FILEIT
          DWN.OK = LINE < LN.CT
          PARSEMOVE COL,LINE,COLS,LN.CT,7,DWN.OK,NO
          ON COL GOTO IN.QTY, IN.SHIP.VIA
*-------------------------------------------------------------------------*
IN.QTY:   INPV QTY,52,LINE,9,'R'
          IF LN.CT < 1 THEN F12 = YES
          IF CHANGED THEN
             NPQ       = PROC.QTYS
             NPQ<LINE> = QTY*UM.QTY
             IF SUM(NPQ) > (MAX.QTY-AVAIL.NOW)*UM.QTY THEN
                VPRINT 52,LINE,PROC.QTYS<LINE>/UM.QTY "R#9"
                PROC.DISP = MAX.QTY - AVAIL.NOW
                IF PROC.DISP < 0 THEN PROC.DISP = 0
                MESS 5,0,BELL:'Maximum Procure quantity : ':PROC.DISP
                GOTO IN.QTY
             END
             AVL.QTY = AVAIL.QTYS<LINE>
             IF NUM(AVL.QTY) AND QTY*UM.QTY>AVL.QTY AND NOT(OV.AVL.OK) THEN
                VPRINT 52,LINE,PROC.QTYS<LINE>/UM.QTY "R#9"
                MESS 5,0,BELL:'Cannot Procure more than avail from this Source'
                GOTO IN.QTY
             END

             IF NUM(AVL.QTY) THEN
                IF CONSIGN.WARN THEN
                   IF SOURCES<LINE>[1,1] = 'B' THEN
                      PROC.BR = SOURCES<LINE>[2,99]
                      GOSUB CHECK.CONSIGN
                      IF VENDOR.CONSIGN THEN
                         WARNING.MSG = 'WARNING: You Are About To Procure Material From A Branch That'
                         WARNING.MSG<-1> = 'Contains Vendor Consigned Material, Continue? (Y/N) '
                         ANS = 'N'
IN$$1:                   INP.PROMPT ANS,WARNING.MSG,'YN'
                         IF NOT(ANS) THEN
                            VPRINT 52,LINE,PROC.QTYS<LINE>/UM.QTY "R#9"
                            QTY = 0
                            GOTO IN.QTY
                         END
                      END
                   END
                END
             END

             IF DIV.OPT = 'O' THEN
                TMP.DIV = DIV(QTY,BUY.PKG)
                TMP.MOD = MOD(QTY,BUY.PKG)
                IF TMP.MOD>0 THEN TMP.DIV +=1
                TMP.QTY = BUY.PKG * TMP.DIV
                *** Check to see if amount that will be order is beyond the
                *** amount available from the source.
                AVL.QTY = AVAIL.QTYS<LINE>
                IF NUM(AVL.QTY) AND TMP.QTY > AVL.QTY AND NOT(OV.AVL.OK) THEN
                   VPRINT 52,LINE,ORIG.QTYS<LINE>/UM.QTY "R#9"
                   MESS 5,0,BELL:'Due To Buy Package Qty, Not Enough Avail From Source.'
                   GOTO IN.QTY
                END
                TMP.PROC.QTYS<LINE> = TMP.QTY
             END
             PROC.QTYS<LINE> = QTY*UM.QTY
          END
          IF F12 THEN GOTO FINISH

          GOTO MOVENEXT
*-------------------------------------------------------------------------*
IN.SHIP.VIA:    *
IN.VIA:   INPV VIA,62,LINE,16,'MCU',V_'SHIP.VIAS'
          IF CHANGED THEN
             READV SVIA.LEAD FROM SVIAFILE,VIA,25 ELSE SVIA.LEAD = ''

             S.VIAS<LINE> = VIA

             ***  Add Ship via lead time to avail date
             IF SVIA.LEAD # '' THEN
                AVAIL.DTS<LINE> = DATE() + SVIA.LEAD
             END ELSE
                AVAIL.DTS<LINE> = DATE() + BR.LEADTIME
             END
             VPRINT 34,LINE,OCONV(AVAIL.DTS<LINE>,'D2/')   "L#8"
          END

          GOTO MOVENEXT
*-------------------------------------------------------------------------*
INIT:     *
          STK.BR   = LED(2)<1,GEN,2>
          BR.OPT   = NO
          PRD.BR.GET.VAL STK.BR,PN,27,DIV.OPT
          TMP.PROC.QTYS = ''
          UN.AV.ALL     = NO  ;* Flag if Procure Unavailable All WIP
          IF NOT(ASSIGNED(PASS.XTRA)) THEN PASS.XTRA = ''

          READV DFLT.VIA FROM CTRLFILE,'DEFAULT.SHIP.VIA.PO',1 ELSE
             DFLT.VIA = ''
          END

          GOSUB GET.PROC.BRS

          MENU.CLEAR
          MENU.LOAD  2,11, 7, 1,'I'
          MENU.LOAD 12,11,14, 9,'L'
          MENU.LOAD 29,11,14, 1,'H'
          IF ALL.BRS.OK THEN
             MENU.LOAD 46,11, 9, 1,'A'
          END ELSE
             MENU.LOAD
          END
          IF ANY.VN THEN
             PRINT @(58,11):'Addl Vendors':
             MENU.LOAD 58,11,12, 6,'V'
          END ELSE
             MENU.LOAD
          END

          IF OID[1,1] = 'W' THEN
             * For Work Order Add Procure Unavailable All Hotkey
             HKDESC = 'Procure All Unavailable '
             PRINT @(17,13):HKDESC
             MENU.LOAD 17,13,23,13,'U'
          END ELSE
             MENU.LOAD
          END

          * Set Surplus needs to be last so it can toggle.
          GOSUB SET.SURPLUS

          RETURN
*-------------------------------------------------------------------------*
*** Set to show availablity or surplus
SET.SURPLUS:*
          MENU.CLEAR 7
          IF SHOW.SURPLUS THEN
             PRINT @(44,2):'Surplus'
             PRINT @(7,13):'Avail  '
             MENU.LOAD  2,13,10, 1,'S'
          END ELSE
             PRINT @(44,2):'AvailQty'
             PRINT @(7,13):'Surplus'
             MENU.LOAD  2,13,12, 1,'S'
          END
          RETURN
*-------------------------------------------------------------------------*
*** Toggle surplus/avail flag
TOGGLE.SURPLUS:*
          SHOW.SURPLUS = NOT(SHOW.SURPLUS)
          GOSUB SET.SURPLUS
          GOSUB DISPLAY
          RETURN
*-------------------------------------------------------------------------*
GET.PROC.BRS: * Check avail in all branches *

          OE.PROCURE.LOAD OID,STK.BR,LDID,QSIGN,KEY.LVL,SOURCES,AVAIL.QTYS,AVAIL.DTS,PROC.QTYS,MAX.QTY,AVAIL.NOW,UM.PER,UM.QTY,SHP.IDS,SHP.QTYS,S.VIAS,BR.OPT,ANY.VN,YES,SURPLUS,SORT.SURPLUS
          SHOW.SURPLUS = SORT.SURPLUS

          OE.GET.QTYS OID,SHP.IDS,SHP.QTYS,QSIGN,LDID
          GOSUB GET.WHSE.FLAG
          LN.CT     = DCOUNT(SOURCES,AM)
          ORIG.QTYS = PROC.QTYS
          ORIG.VIAS = S.VIAS

          * PROC.QTYS comes here all summed together, but we need them
          * as they are stored here we will get them from PROCQFILE
          FOR LINE = 1 TO LN.CT
             SOURCE = SOURCES<LINE>
             PQ.ID  = OID:'~':LDID:'~':SOURCE
             READ TPREC FROM PROCQFILE,PQ.ID ELSE TPREC = ''
             PROC.QTYS<LINE> = TPREC<1>
          NEXT I
          LINE = 1

          RETURN
*-------------------------------------------------------------------------*
DISPLAY:  *** Display

          PROC.DISP = MAX.QTY - AVAIL.NOW
          IF PROC.DISP < 0 THEN PROC.DISP = 0
          PRINT @(18,1):PROC.DISP "R#6"

          IF BR.OPT THEN
             PRINT @(70,0):BLINK$:'*All*':NORM$
          END ELSE
             PRINT @(70,0):''
          END

          STXT = ''; ETXT = ''
          IF UM.PER # LD(23) OR UPCASE(UM.PER) # 'EA' THEN STXT = BLINK$; ETXT = NORM$
          PRINT @(30,1):STXT:'Per: ':UM.PER:'=':UM.QTY:ETXT

          VCLR 1
          FOR LN = 1 TO LN.CT
             GOSUB DISP.LN
          NEXT LN

          RETURN
*-------------------------------------------------------------------------*
DISP.LN:*** Display one line of data at a time.
          SOURCE               = SOURCES<LN>
          WH.FLG               = WHSE.FLAGS<LN>
          ID                   = SHP.IDS<LN>
          PQ.ID                = OID:'~':LDID:'~':SOURCE
          PROCURE.SOURCE.CHECK SOURCE,IS.VALID,BR.ID,VN.ID
          BEGIN CASE
          CASE NOT(IS.VALID)
             SRC.DESC          = '* Invalid Source *'
          CASE BR.ID
             PROC.BR = BR.ID
             READV NAME FROM TERRFILE,PROC.BR,1 ELSE NAME = ''
             IF NOT(NAME) THEN
                READV ENT.ID FROM TERRFILE,PROC.BR,4 ELSE ENT.ID = ''
                READV NAME FROM CUSFILE,ENT.ID,1 ELSE NAME=''
             END
             IF WH.FLG THEN
                WH.FLG = '(C)'
             END
             SRC.DESC = "Brch #":PROC.BR"L#4":WH.FLG"L#3":' - ':NAME"L#17"
          CASE VN.ID
             READV SRC.DESC FROM CUSFILE,SOURCE,1 ELSE SRC.DESC = ''
          END CASE

          IF DIV.OPT = 'O' THEN
             VPRINT  0,LN,SRC.DESC                  "L#25"
             PRD.BR.GET.VAL STK.BR,PN,4,BUY.PKG
             IF BUY.PKG > 1 THEN
                BUY.PKG.STR = '(':BUY.PKG:')'
                VPRINT 25,LN,BUY.PKG.STR            "R#8"
             END
          END ELSE
             VPRINT  0,LN,SRC.DESC                  "L#33"
          END

          VPRINT 34,LN,OCONV(AVAIL.DTS<LN>,'D2/')   "L#8"
          IF SHOW.SURPLUS THEN
             QTY = SURPLUS<LN>
          END ELSE
             QTY = AVAIL.QTYS<LN>
          END
          IF NUM(QTY) THEN
             VPRINT 43,LN,QTY/UM.QTY                "R#8"
          END ELSE
             VPRINT 43,LN,QTY                       "R#8"
          END
          VPRINT 52,LN,PROC.QTYS<LN>/UM.QTY         "R#9"

          VPRINT 62,LN,S.VIAS<LN>                   "L#16"

          RETURN
*-------------------------------------------------------------------------*
SUBS:     ON OPTION GOTO INV.INQ, PROD.LGR, HIST.LGR, GET.ALL.BRS, IN.VN, PROALLUN, TOGGLE.SURPLUS
*-------------------------------------------------------------------------*
PROALLUN: * Procure All Unavailable for same buy line as product we are on
          * Used only for Work Orders

          PRO.BL = PRD(12)
          SV.LOG.MV = LOG.MV
          SV.LDID   = LDID
          SELPAU    = ''
          SLNCTR    = 0
          PAULDIDS  = RAISE(LED(48)<1,GEN>)

          SELITEMS = ''
          PAU.CT   = DCOUNT(PAULDIDS,VM)
          FOR PAU = 1 TO PAU.CT
             PLDID = PAULDIDS<1,PAU>
             LD.GET PLDID
             PPN = LD(1)
             PQO = LD(4)

             * Check if product and only allow component qtys not assem
             IF NOT(NUM(PPN)) OR PQO >= 0     THEN CONTINUE

             READV PBL FROM PRDFILE,PPN,12    ELSE CONTINUE

             * Buy Line for other products must be same as product
             * that was in the Procure screen to start.
             IF PBL # PRO.BL                  THEN CONTINUE

             * All existing Procures are in LD6 so just need to get
             * procure qty in LD 5
             PSQTY = SUM(LD(5)<1,GEN>)

             * If nothing left to fill for procure qty then no need
             * to check avail LD5 SUM = 0
             IF NOT(PSQTY) THEN CONTINUE

             * Send Yes to indicate only want want is on hand tagged
             * for availability now
             MATREAD PRD FROM PRDFILE,PPN     ELSE CONTINUE

             * Get the quantity already procured
             PNQTY = SUM(LD(6)<1,GEN>)

             OE.CHECK.AVAIL.NOW OID,GEN,PLDID,PAVAIL.QTY
             * Need to back out the quantity already procured on the
             * LD
             PAVAIL.QTY += PNQTY

             IF PAVAIL.QTY < 0 THEN PAVAIL.QTY = 0

             PQDIF = ABS(PSQTY)-PAVAIL.QTY

             * Don't allow a negative procurement for avail greater
             * than quantity needed.
             IF PQDIF > 0 THEN
                SLN   = PLDID:VM:PPN:VM:PQDIF
                SLNCTR += 1
                SELPAU<SLNCTR>   = SLN
                SELITEMS<SLNCTR> = PPN
             END
          NEXT PAU


          SELVALS=''
          * Set overide to yes to return postion if item selected in
          * the SELITEMS array
          WIP.PROCURE.MULTI SELVALS,SELPAU,YES
          POS.CT = DCOUNT(SELVALS,AM)
          IF POS.CT THEN
             UN.AV.ALL = YES
             FOR POSC = 1 TO POS.CT
                SELPOS = SELVALS<POSC>
                LDID   = SELPAU<SELPOS,1>
                PUQTY  = SELPAU<SELPOS,3> * UM.QTY
                LD.GET LDID
                MAT OLD.LD = MAT LD
                GET.ALL.PRD STK.BR,LD(1),QSIGN,GROUP

                * Get Procurement info for this line
                OE.PROCURE.LOAD OID,STK.BR,LDID,QSIGN,KEY.LVL,SOURCES,AVAIL.QTYS,AVAIL.DTS,PROC.QTYS,MAX.QTY,AVAIL.NOW,UM.PER,UM.QTY,SHP.IDS,SHP.QTYS,S.VIAS,BR.OPT,ANY.VN,BVN.OK,SURPLUS,SORT.SURPLUS

                IF FIELD(SHP.IDS<1>,'~',3) = 'S' AND SOURCES<1> THEN
                   * If ship ids is valid Stock dflt then need to procure
                   * amt that is not available.
                   PROC.QTYS = PUQTY    ;* Quantity to Procure
                   LOG.MV = GEN
                   OE.PROCURE.UPD OID,GEN,LDID,LOG.MV,SHP.QTYS,SHP.IDS,PROC.QTYS,SOURCES,AVAIL.DTS,MAX.QTY,QSIGN,S.VIAS,,ORIG.QTYS,ACTIONS,RESPS
                   OE.PROCURE.UPD.CMT OID,GEN,LDID,QSIGN,LOG.MV,PROC.QTYS,LN.CT

                END
             NEXT POSC
          END

          LOG.MV = SV.LOG.MV
          LDID   = SV.LDID
          LD.GET LDID
          MAT OLD.LD = MAT LD
          GET.ALL.PRD STK.BR,LD(1),QSIGN,GROUP
          RETURN TO FINISH

*-------------------------------------------------------------------------*
INV.INQ:  INV.INQ PN,STK.BR

          RETURN
*-------------------------------------------------------------------------*
PROD.LGR: IF SOURCES<LINE>[1,1]#'B' THEN PRINT BELL:; RETURN
          TMP.BR = SOURCES<LINE>[2,99]
          PRODUCT.LEDGER TMP.BR,PN

          RETURN
*-------------------------------------------------------------------------*
HIST.LGR: IF SOURCES<LINE>[1,1]#'B' THEN PRINT BELL:; RETURN
          TMP.BR = SOURCES<LINE>[2,99]
          INV.HISTORY.LEDGER PN,,TMP.BR

          RETURN
*-------------------------------------------------------------------------*
GET.ALL.BRS: * Check avail in all branches *
          BR.OPT   = YES
          RECHK.OK = YES
          GOSUB GET.PROC.BRS
          GOSUB DISPLAY

          RETURN
*-------------------------------------------------------------------------*
IN.VN:    *** Input Procurement Vendor
          VN = ''
IN.VN2:   INP.PROMPT VN,'Procure Vendor:','TENTITY;X;1;1',20,'S:VERF.VEN.SF.NODEL'
          IF QUIT THEN RETURN

          IF CHANGED THEN
             LOCATE VN IN SOURCES SETTING POS THEN
                LINE = POS
             END ELSE
                LN.CT += 1
                LN     = LN.CT
                LINE   = LN

                VIA = DFLT.VIA
                IF VIA = '' THEN
                   READV VIA FROM CUSFILE,VN,46 ELSE VIA = ''
                END

                LEADTIME = ANY.VN<1,2>
                IF LEADTIME = '' THEN
                   PRDC.BR.GET.VAL STK.BR,PN,5,PRDC.LT
                   PRD.LEAD.TIME.GET LEADTIME,PN,STK.BR,PRD(12),PRDC.LT
                END

                SHP.DT   = LED(9)<1,GEN>
                SHP.BR   = LED(2)<1,GEN,2>
                STAT     = LED(6)<1,GEN,1>
                INVN     = LED(8)<1,GEN>
                TYP      = 'S'
                MAKE.FLG = '~~'
                LOC      = ''
                REQ.DT   = ''

                IF LED(110)<1,1>='B' OR LED(110)<1,1>='R' OR LED(110)<1,1>='T' THEN
                   ST.CN = LED(5)<1,GEN>
                   OE.GET.CONSIGN.TYPE ST.CN,LED(110),TYP
                END

                READV PRD.STAT FROM PRDFILE,LD(1),3 ELSE PRD.STAT=1
                IF PRD.STAT=9 THEN LOT.BILL.FLAG=LDID ELSE LOT.BILL.FLAG=''

                ID=SHP.DT"R%6":'~':SHP.BR:'~':TYP:'~':LOC:'~':STAT:'~':INVN:'~':GEN:'~':REQ.DT:'~':VIA:'~~':MAKE.FLG:'~~':LOT.BILL.FLAG

                SOURCES<LINE>    = VN
                AVAIL.QTYS<LINE> = 'Plenty'
                SURPLUS<LINE>    = 0
                AVAIL.DTS<LINE>  = DATE() + LEADTIME
                PROC.QTYS<LINE>  = 0
                SHP.IDS<LINE>    = ID
                SHP.QTYS<LINE>   = 0
                S.VIAS<LINE>     = VIA
                WHSE.FLAGS<LINE> = ''
                GOSUB DISP.LN
             END
          END ELSE
             GOTO IN.VN
          END

          RETURN
*-------------------------------------------------------------------------*
CHK.PIL:  *** Check the control file for the maximum days supply and make
          *** sure this will not put them over it.
     PIL.OK = YES
*
          *** If the Divisibility is set to 'O' then one can only procure
          *** quantities in multiples of the buy quantity.  If this exceeds
          *** the PIL (Projected Inventory Level) and they do not have
          *** authorization to continue, the user will be forced to change
          *** the qty on the order to the proper multiple of the buy
          *** quantity to fullfil the order.
          *** If the user has authorization to exceed the PIL and does,
          *** they can procure whatever amount they want and the remainder
          *** will be put in stock.
          *** If the amount does not exceed the PIL then the amount the
          *** user wishes can be procured and then transparent to the user,
          *** the remainder will be ordered to fullfill the buy package qty
          *** and be put into stock.
      IF DIV.OPT = 'O' THEN
             *** Check amount that will be put in stock (if they have the
             *** proper authorization).
*             QDIF = SUM(TMP.PROC.QTYS)-SUM(ORIG.QTYS)-SUM(PROC.QTYS)
*             OE.CHK.PIL OID,GEN,STK.BR,PN,QDIF,PIL.OK,ADDL.INFO
*             BEGIN CASE
*             CASE PIL.OK
*             *** Overrode PIL check or PN not over MDS which means they
*             *** are allowed to procure the broken qty and we will put the
*             *** rest in stock PIL.OK<1> -or-
*             *** They overrode MDS and still want the product added which
*             *** means procure broken qty and put the rest in stock
*             *** PIL.OK<2>
*                LD(113) = SUM(TMP.PROC.QTYS) - SUM(PROC.QTYS)
*             CASE OTHERWISE
*             *** Do not have authorization so we will force the user to
*             *** order full amount in buy pkg multiples
*                PROC.QTYS    = TMP.PROC.QTYS
*                SHP.QTYS     = SUM(TMP.PROC.QTYS)
*                LD(4)        = SUM(TMP.PROC.QTYS)*QSIGN
*             END CASE
*          END ELSE
*             IF MODE = 'S' AND NEW.ORDER AND NEW.PIL           THEN RETURN
*             IF MODE = 'S' AND LED(33)<1,GEN> AND DIR.PIL      THEN RETURN
*             IF MODE = 'S' AND LED(6)<1,GEN> = 'D' AND DIR.PIL THEN RETURN
*             IF PRD(3) = 3 OR PRD(3) = 6 OR PRD(3) = 9         THEN RETURN
*             *** Otherwise, just check the PIL and go from there.
*             QDIF = SUM(PROC.QTYS)-SUM(ORIG.QTYS)
*             OE.CHK.PIL OID,GEN,STK.BR,PN,QDIF,PIL.OK,ADDL.INFO
     END

          *** Log the UET event if the manually overrode MDS warning
          UET.ENABLED = NO
          IF UET.ENABLED$ THEN
             CTRB.ID = 'UET.ENABLED~':LED(2)<1,GEN,2>
             READV UET.ENABLED FROM CTRBFILE,CTRB.ID,1 ELSE UET.ENABLED=NO
          END

          IF PIL.OK<1> AND PIL.OK<2> AND UET.ENABLED THEN
             OID.DATA$<1> = OID
             OID.DATA$<2> = GEN
             OID.DATA$<3> = LDID
             OID.DATA$<4> = LED(5)<1,GEN>
             OID.DATA$<5> = PN
             UET.LOG.AUTO 'PEMDS',9,QDIF
          END

          RETURN
*-------------------------------------------------------------------------*
GET.WHSE.FLAG: * Determines central whse flags
          WHSE.FLAGS = ''
          PCGID      = GET.PCGID(PRD(18),PRD(12))
          WH.OF      = WHSE.OF(STK.BR,PCGID)
          DCNT = DCOUNT(SOURCES,AM)
          FOR W = 1 TO DCNT
             SRC.ID = SOURCES<1,W>
             IF SRC.ID[1,1] = 'B' THEN
                SRC.BR = TRIM(SRC.ID[2,99])
                IF SRC.BR = WH.OF THEN
                   WHSE.FLAGS<1,W> = YES
                END
             END
          NEXT W

          RETURN
*-------------------------------------------------------------------------*
CHECK.CONSIGN: * Check procurement branch for vendor consignment stock

          MATBUILD SV.PRDD FROM PRDD.BR
          PRDD.BR.GET PROC.BR,PN
          VENDOR.CONSIGN = NO
          LOC.CNT = DCOUNT(PRDD.BR(8),VM)
          FOR L = 1 TO LOC.CNT UNTIL VENDOR.CONSIGN
             TST.LOC = PRDD.BR(8)<1,L>
             LOC.TYP = FIELD(TST.LOC,'~',1)
             IF LOC.TYP[1,1] = 'S' THEN
                IF LOC.TYP[2,99] # '' THEN
                   VENDOR.CONSIGN = YES
                END
             END
          NEXT L
          MATPARSE PRDD.BR FROM SV.PRDD

          RETURN
*-------------------------------------------------------------------------*
FILEIT:   IF F12 THEN
             CONFIRM.ABORT SURE
             IF NOT(SURE) THEN GOTO IN.QTY
             GOTO FINISH
          END

*** If no changes were made on screen, no need for update - we need to
*** first trim off any unnecessary atribute marks
          TMP.QTYS     = PROC.QTYS
          CONVERT AM TO '' IN TMP.QTYS
          IF TMP.QTYS  = '' THEN PROC.QTYS = ''
          IF ORIG.QTYS = PROC.QTYS AND ORIG.VIAS = S.VIAS THEN
             GOTO FINISH
          END

          IF SUM(ORIG.QTYS) < SUM(PROC.QTYS) THEN
             GOSUB CHK.PIL
             IF NOT(PIL.OK) AND DIV.OPT # 'O' THEN PROC.QTYS = ORIG.QTYS
          END

          ACTIONS = ''
          RESPS   = ''
          LOOP
             OE.PROCURE.UPD OID,GEN,LDID,LOG.MV,SHP.QTYS,SHP.IDS,PROC.QTYS,SOURCES,AVAIL.DTS,MAX.QTY,QSIGN,S.VIAS,,ORIG.QTYS,ACTIONS,RESPS
             IF ACTIONS THEN
                ACTION.DISPLAY ACTIONS,ABORTED,RESPS,ONLY.ONE
             END ELSE
                EXIT
             END
          REPEAT

          OE.PROCURE.UPD.CMT OID,GEN,LDID,QSIGN,LOG.MV,PROC.QTYS,LN.CT

          MATREAD LED FROM LEDFILE,OID ELSE NULL

          LD.GET LDID
          MAT OLD.LD = MAT LD
*-------------------------------------------------------------------------*
FINISH:   QUIT = 0
          WINDOW.CLOSE

          PASS.XTRA<1> = UN.AV.ALL

          RETURN
*-------------------------------------------------------------------------*
!SMITJR~03/15/10~18:42
